﻿
Imports System.IO

'a simple virtdisk, support read & write a certain length, not follow the sector size 512
Public Class virtdisk
    Private Const defaultBuffSize As Int32 = 4096
    Private s As Stream = Nothing

    Public Function valid() As Boolean
        Return Not s Is Nothing AndAlso s.CanRead() AndAlso s.CanWrite() AndAlso s.CanSeek()
    End Function

    Public Function close() As Boolean
        closestream(s)
        Return True
    End Function

    Public Function size() As Int64
        If valid() Then
            Return s.Length()
        Else
            Return npos
        End If
    End Function

    Public Function open(ByVal filename As String, Optional ByVal buffSize As Int32 = defaultBuffSize) As Boolean
        If buffSize <= 0 Then
            buffSize = defaultBuffSize
        End If
        Try
            s = New FileStream(filename, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.Read, buffSize)
            Return True
        Catch ex As Exception
            raiseError("cannot open file " + filename + ", ex " + ex.Message, errorHandle.errorType.exclamation)
            Return False
        End Try
    End Function

    Private Function readPrecheck(ByVal start As Int64, ByVal length As Int64) As ternary
        If Not valid() OrElse start < 0 OrElse length < 0 OrElse start + length > s.Length Then
            Return ternary.false
        ElseIf length = 0 Then
            Return ternary.true
        Else
            Return ternary.unknown
        End If
    End Function

    Public Function read(ByVal start As Int64, ByVal length As Int64, ByRef output As bytes) As Boolean
        Dim pre As ternary = Nothing
        pre = readPrecheck(start, length)
        If pre.true_() Then
            If output Is Nothing Then
                output = New bytes()
            Else
                output.clear()
            End If
            output.size = length
            Return True
        ElseIf pre.false_() Then
            Return False
        Else
            Return readstream(s, output, start, length) = length
        End If
    End Function

    Public Function read3(ByVal start As Int64, ByVal length As Int64,
                          Optional ByVal output As pointer(Of bytes) = Nothing,
                          Optional ByRef action As callbackAction = Nothing) As Boolean
        Dim pre As ternary = Nothing
        pre = readPrecheck(start, length)
        If pre.true_() Then
            If Not output Is Nothing Then
                Dim b As bytes = Nothing
                b = New bytes()
                b.size = length
                output.set(b)
            End If
            action = callbackAction.finished_success()
            Return True
        ElseIf pre.false_() Then
            Return False
        Else
            Return readstream3(s, start, length, action:=action, result:=output)
        End If
    End Function

    Public Function read4(ByVal start As Int64, ByVal length As Int64,
                          Optional ByVal output As pointer(Of bytes) = Nothing,
                          Optional ByRef ec As eventComb = Nothing) As Boolean
        Dim pre As ternary = Nothing
        pre = readPrecheck(start, length)
        If pre.true_() Then
            If Not output Is Nothing Then
                Dim b As bytes = Nothing
                b = New bytes()
                b.size() = length
                output.set(b)
            End If
            ec = Nothing
            Return True
        ElseIf pre.false_() Then
            Return False
        Else
            Return readstream4(s, start, length, ec:=ec, result:=output)
        End If
    End Function

    Private Function writePrecheck(ByVal start As Int64, ByVal input As bytes) As ternary
        If Not valid() OrElse input Is Nothing OrElse start < 0 Then
            Return ternary.false
        ElseIf input.size() = 0 Then
            Return ternary.true
        Else
            Return ternary.unknown
        End If
    End Function

    Private Function set_position(ByVal i As Int64) As Boolean
        Try
            s.Position() = i
            Return True
        Catch ex As Exception
            raiseError("cannot set position, ex " + ex.Message, errorHandle.errorType.exclamation)
            Return False
        End Try
    End Function

    Public Function write(ByVal start As Int64, ByVal input As bytes) As Boolean
        Dim pre As ternary = Nothing
        pre = writePrecheck(start, input)
        If pre.unknown_() Then
            Return set_position(start) AndAlso writestream(s, +input)
        Else
            Return pre.true_()
        End If
    End Function

    Public Function write3(ByVal start As Int64, ByVal input As bytes,
                           Optional ByRef action As callbackAction = Nothing) As Boolean
        Dim pre As ternary = Nothing
        pre = writePrecheck(start, input)
        If pre.true_() Then
            action = callbackAction.finished_success()
            Return True
        ElseIf pre.false_() Then
            Return False
        Else
            Return set_position(start) AndAlso writestream3(s, +input, action:=action)
        End If
    End Function

    Public Function write4(ByVal start As Int64, ByVal input As bytes,
                           Optional ByRef ec As eventComb = Nothing) As Boolean
        Dim pre As ternary = Nothing
        pre = writePrecheck(start, input)
        If pre.unknown_() Then
            Return set_position(start) AndAlso writestream4(s, +input, ec:=ec)
        Else
            ec = Nothing
            Return pre.true_()
        End If
    End Function

    Public Function fill(ByVal start As Int64, ByVal length As Int64) As Boolean
        If Not valid() Then
            Return False
        End If
        If s.Length < start + length Then
            Try
                s.SetLength(start + length)
            Catch ex As Exception
                raiseError("cannot fill virtdisk, ex " + ex.Message, errorHandle.errorType.exclamation)
                Return False
            End Try
        End If
        Return True
    End Function

    Public Function [erase](ByVal start As Int64) As Boolean
        If Not valid() Then
            Return False
        End If
        If s.Length > start Then
            Try
                s.SetLength(start)
            Catch ex As Exception
                raiseError("cannot erase virtdisk, ex " + ex.Message, errorHandle.errorType.exclamation)
                Return False
            End Try
        End If
        Return True
    End Function

    Public Function flush() As Boolean
        If Not valid() Then
            Return False
        End If
        s.Flush()
        Return True
    End Function
End Class
